{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Bitmaps;

interface

uses Classes, UIObjects, Graphic, Colour, Colours, Fills, AHMTypes, XMLHelper;

{$IFDEF DESIGNER}
const
  MODIFY_CAPTION = 'Load Bitmap';

  // Property categories and hints for designer
  CAT_BITMAP = 'Bitmap';
  HINT_FILENAME = 'defines the filename for this bitmap in the theme resources directory';
  HINT_ASPECT = 'controls whether the aspect ratio of the bitmap is preserved when sizing';
  HINT_COLOUR = 'specifies the name of a colour item to use for tinting the bitmap';
  HINT_FILL = 'specifies the name of a fill item to use for shading the bitmap';
  HINT_DEMAND = 'controls whether the bitmap is loaded at startup or when required';
  HINT_WIDTH = 'specifies custom width for the bitmap (or 0 to use default width)';
  HINT_HEIGHT = 'specifies custom height for the bitmap (or 0 to use default height)';
{$ENDIF}

type
  TAHMBitmap = class(TAHMUIDisplayObject)
  private
    FFilename: TAHMFilename;
    FFileURL: WideString;
    FAspect: Boolean;
    FGraphic: TAHMGraphic;
    FColour: TAHMColour;
    FColourMix: TAHMCanvasColour;
    FFill: TAHMAbstractFill;
    FLoadOnDemand: Boolean;
    FLoaded: Boolean;
    FOriginalWidth: Integer;
    FOriginalHeight: Integer;
  protected
    procedure SetFileURL(URL: WideString);
    procedure SetFilename(Filename: TAHMFilename);
    procedure SetVirtualWidth(Width: Integer); override;
    procedure SetVirtualHeight(Height: Integer); override;
    procedure ClearProperties; override;
  public
    constructor Create(const Name: String); override;
    destructor Destroy; override;
    property FileURL: WideString read FFileURL write SetFileURL;
    property Graphic: TAHMGraphic read FGraphic;
    property OriginalWidth: Integer read FOriginalWidth write FOriginalWidth;
    property OriginalHeight: Integer read FOriginalHeight write FOriginalHeight;
    function ModifyActions: Integer; override;
    function Modify(Action: Integer): Boolean; override;
    function ModifyCaption(Action: Integer): String; override;
    procedure Load(const FileName: String);
    procedure LoadFromURL(const URL: String);
    procedure Render(Control: TObject; iX, iY, iWidth, iHeight: Single); override;
    procedure Render(Control: TObject; iX, iY, iWidth, iHeight: Single; Clip: Boolean); override;
    procedure SeedObject; override;
    procedure Assign(Source: TPersistent); override;
    procedure SaveXMLBody(Lines: TStrings); override;
    procedure ParseFromXML(XML: TAHMXMLHelper); override;
    procedure BuildProperties(Properties: TAHMUIPropertyList); override;
  published
    property Filename: TAHMFilename read FFilename write SetFilename;
    property PreserveAspect: Boolean read FAspect write FAspect;
    property Colour: TAHMColour read FColour write FColour;
    property Fill: TAHMAbstractFill read FFill write FFill;
    property LoadOnDemand: Boolean read FLoadOnDemand write FLoadOnDemand;
    // Publish inherited properties
    property VirtualWidth;
    property VirtualHeight;
  end;

  TAHMBitmapList = class(TAHMUIObjectList)
  private
  protected
  public
    constructor Create; override;
    function AddBitmap(const InheritFrom, NewName: String): TAHMBitmap;
    function GetBitmap(const Name: String): TAHMBitmap;
    function LoadBitmaps: Boolean;
    procedure PopulateDefaultObjects; override;
  end;


implementation

uses SysUtils, Types, ApplicationManager, TagNames, XMLTags, Screen, Viewport,
     BaseControls, ErrorCodes, ScreenSaver;

constructor TAHMBitmapList.Create;
begin
  inherited Create;

  XMLTagName := TAG_BITMAPS;
  ChildClass := TAHMBitmap;
end;

function TAHMBitmapList.AddBitmap(const InheritFrom, NewName: String): TAHMBitmap;
begin
  Result := TAHMBitmap(Inherit(InheritFrom, NewName));
end;

function TAHMBitmapList.GetBitmap(const Name: String): TAHMBitmap;
begin
  Result := TAHMBitmap(GetObject(Name));
end;

function TAHMBitmapList.LoadBitmaps: Boolean;
var
  i: Integer;
  oBitmap: TAHMBitmap;
begin
  for i := 0 to Pred(Count) do
  begin
    oBitmap := TAHMBitmap(Objects[i]);
    if not oBitmap.LoadOnDemand then
      oBitmap.Load(oBitmap.Filename);
  end;

  // We should add some more sophisticated error checking later
  Result := True;
end;

procedure TAHMBitmapList.PopulateDefaultObjects;
begin
  with ApplicationManagerInstance, DefaultObject as TAHMBitmap do
    FileURL := UIManager.ResourceURL + SAVER_IMAGE_FILE;

  with ApplicationManagerInstance, DefaultObjects[TAG_GAUGE] as TAHMBitmap do
    FileURL := UIManager.ResourceURL + 'gauge.png';
end;


//----------------------------------------------------------------------------//
constructor TAHMBitmap.Create(const Name: String);
begin
  inherited Create(Name);

  XMLTagName := TAG_BITMAP;
  ObjectType := otBitmaps;
  ImageIndex := Ord(otBitmaps);

  FGraphic := TAHMGraphic.Create;
  FColourMix := TAHMCanvasColour.Create;
end;

destructor TAHMBitmap.Destroy;
begin
  FGraphic.Free;
  FColourMix.Free;

  inherited Destroy;
end;

procedure TAHMBitmap.SetFileURL(URL: WideString);
begin
  // If file url is changed after we're loaded then reload image
  if FLoaded and (URL <> FFileURL) then
  begin
    FLoaded := False;
    VirtualWidth := FOriginalWidth;
    VirtualHeight := FOriginalHeight;
    LoadFromURL(URL);
  end;

  FFileURL := URL;
end;

procedure TAHMBitmap.SetFilename(Filename: TAHMFilename);
begin
  // If filename is changed after we're loaded then reload image
  if FLoaded and (Filename <> FFilename) then
  begin
    FLoaded := False;
    VirtualWidth := FOriginalWidth;
    VirtualHeight := FOriginalHeight;
    Load(Filename);
    ApplicationManagerInstance.UIManager.InvalidateUIObject(Self);
  end;

  FFilename := Filename;
end;

procedure TAHMBitmap.SetVirtualWidth(Width: Integer);
begin
  inherited;

  // Update original dimensions in theme designer
  FOriginalWidth := Width;
end;

procedure TAHMBitmap.SetVirtualHeight(Height: Integer);
begin
  inherited;

  // Update original dimensions in theme designer
  FOriginalHeight := Height;
end;

procedure TAHMBitmap.ClearProperties;
begin
  inherited;

  // Clear custom bitmap properties
  FFilename := '';
  FAspect := False;
  FColour := nil;
  FFill := nil;
  FLoadOnDemand := False;
  FLoaded := False;
  VirtualWidth := 0;
  VirtualHeight := 0;
end;

function TAHMBitmap.ModifyActions: Integer;
begin
  // Bitmap only supports editing filename
  Result := 1;
end;

function TAHMBitmap.Modify(Action: Integer): Boolean;
var
  NewFile: String;
begin
  // Use theme manager to select and copy image file
  NewFile := FFileName;
  Result := ApplicationManagerInstance.ThemeManager.AddThemeResource(NewFile, rtImage);

  if Result then
  begin
    SetFilename(NewFile);
    DoModified;
  end;
end;

function TAHMBitmap.ModifyCaption(Action: Integer): String;
begin
{$IFDEF DESIGNER}
  Result := MODIFY_CAPTION;
{$ELSE}
  Result := '';
{$ENDIF}
end;

procedure TAHMBitmap.Load(const FileName: String);
var
  sResourceURL: String;
begin
  FFilename := FileName;
  if FLoaded then Exit;

  // Get theme resource URL to prefix image location
  sResourceURL := ApplicationManagerInstance.ThemeManager.ThemeResourceURL;

  // Delegate to method below - load from standard resource location
  LoadFromURL(sResourceURL + FileName);
end;

procedure TAHMBitmap.LoadFromURL(const URL: String);
begin
  FFileURL := URL;
  if FLoaded then Exit;
  FLoaded := True;

  // If bitmap size is already set then ask graphic to size it on load
  FGraphic.Width := Self.Width;
  FGraphic.Height := Self.Height;
  FGraphic.PreserveAspect := Self.PreserveAspect;

  // Load image and retrieve bitmap dimensions
  if FGraphic.LoadFromFile(URL) then
  begin
    // Update physical and virtual dimensions
    Width := FGraphic.ImageWidth / ScreenInstance.PhysicalWidth;
    Height := FGraphic.ImageHeight / ScreenInstance.PhysicalHeight;
    FVirtWidth := ScreenInstance.ScalePhysicalX(Width);
    FVirtHeight := ScreenInstance.ScalePhysicalY(Height);
    if State = osWarn then State := osValid;
  end
  else
    State := osWarn;
end;

procedure TAHMBitmap.Render(Control: TObject; iX, iY, iWidth, iHeight: Single);
begin
  // Delegate to method below without clipping
  Render(Control, iX, iY, iWidth, iHeight, False);
end;

procedure TAHMBitmap.Render(Control: TObject; iX, iY, iWidth, iHeight: Single; Clip: Boolean);
var
  Rect: TAHMRectF;
  Shade: TAHMCanvasShade;
begin
  // Load bitmap on demand if not already loaded
  if not FLoaded then LoadFromURL(FFileURL);

  // We may get passed a container or control, so use base class
  with Control as TAHMAbstractControl do
  begin
    // Get gamma correction value if assigned
    if Assigned(FColour) then FColourMix.Pixel := FColour.Colour.GammaCorrect(Gamma)
                         else FColourMix.Assign(Gamma);

    // Use control dimensions if set, otherwise graphic size
    if (iWidth <> 0) and (iHeight <> 0) then Rect := CanvasRect(iX, iY, iWidth, iHeight)
    else Rect := CanvasRect(iX, iY, Self.Width, Self.Height);

    // Use fill shading if populated, otherwise use gamma
    if FFill <> nil then Shade := FFill.Shade else Shade := nil;

    // Draw graphic with clipping if required
    if Clip then
      Viewport.Canvas.DrawGraphic(Rect, ClipRect, FGraphic, Shade, FColourMix, XScale, YScale, HorizontalFlip, VerticalFlip)
    else
      Viewport.Canvas.DrawGraphic(Rect, FGraphic, Shade, FColourMix, XScale, YScale, HorizontalFlip, VerticalFlip)
  end;
end;

procedure TAHMBitmap.SeedObject;
begin
{$IFDEF DESIGNER}
  if Ancestor = nil then
  begin
    // Force bitmap to be reloaded when filename is changed
    FLoaded := True;
  end;
{$ENDIF}
end;

procedure TAHMBitmap.Assign(Source: TPersistent);
begin
  inherited Assign(Source);

  with Source as TAHMBitmap do
  begin
    Self.Filename := Filename;
    Self.PreserveAspect := PreserveAspect;
    Self.Colour := Colour;
    Self.Fill := Fill;
    Self.LoadOnDemand := LoadOnDemand;
    Self.Graphic.Assign(Graphic);
  end;
end;

procedure TAHMBitmap.SaveXMLBody(Lines: TStrings);
var
  oAncs: TAHMBitmap;
  sWork: String;
begin
  // Determine which ancestor to compare against - real or empty
  oAncs := TAHMBitmap(ObjectToCompare);

  // Only populate attributes that differ from our ancestor
  if (FFilename <> '') and (FFilename <> oAncs.Filename) then
    Lines.Add(TABS[3] + TGB+TAG_FILENAME+TGC + EncodeXML(FFilename) + TGE+TAG_FILENAME+TGC);
  if (FColour <> nil) and (FColour <> oAncs.Colour) then
    Lines.Add(TABS[3] + FColour.XMLReference);
  if (FFill <> nil) and (FFill <> oAncs.Fill) then
    Lines.Add(TABS[3] + FFill.XMLReference);

  // Do we need to store size?
  if ((VirtualWidth <> 0) and (VirtualWidth <> oAncs.VirtualWidth)) or
     ((VirtualHeight <> 0) and (VirtualHeight <> oAncs.VirtualHeight)) or
     (FAspect <> oAncs.PreserveAspect) then
  begin
    sWork := TGB+TAG_SIZE;
    if PreserveAspect <> oAncs.PreserveAspect then
      sWork := sWork + SPC+ATTR_ASPECT+ATB + Bool2Str(FAspect) + ATQ;
    if ((VirtualWidth <> 0) and (VirtualWidth <> oAncs.VirtualWidth)) or
       ((VirtualHeight <> 0) and (VirtualHeight <> oAncs.VirtualHeight)) then
      sWork := sWork + TGC + IntToStr(VirtualWidth) + ',' +
               IntToStr(VirtualHeight) + TGE+TAG_SIZE+TGC
    else
      sWork := sWork + ETE;
    Lines.Add(TABS[3] + sWork);
  end;

  // Do we need to store load on demand?
  if FLoadOnDemand or (FLoadOnDemand <> oAncs.LoadOnDemand) then
    Lines.Add(TABS[3] + TGB+TAG_LOADING+SPC+ATTR_ONDEMAND+ATB + Bool2Str(FLoadOnDemand) + ATE);
end;

procedure TAHMBitmap.ParseFromXML(XML: TAHMXMLHelper);
var
  sFilename, sAspect, sColour, sFill, sLoad: String;
  iX, iY: Integer;
  BitmapNode, PropsNode: TAHMXMLNode;
begin
  // Initialise parsing nodes
  BitmapNode := XML.CurrentNode;
  PropsNode := nil;

  // Check for optional filename and size elements
  while XML.NextElement(BitmapNode, PropsNode) do
    with ApplicationManagerInstance.ThemeManager.VisualDescriptor do
      if XML.CurrentElement = TAG_FILENAME then
      begin
        sFilename := XML.GetValue;
        if sFilename <> '' then Filename := sFilename;
      end
      else if XML.CurrentElement = TAG_SIZE then
      begin
        sAspect := XML.GetAttribute(ATTR_ASPECT);
        if sAspect <> '' then PreserveAspect := Str2Bool(sAspect);

        // Size should be defined in x,y format
        if not XML.GetCoordsValue(iX, iY) then
          LogParsingError(THM_PRS_VIS_MALFORMED_BITMAP_SIZE_TAGS, Self);

        if (iX <> 0) and (iY <> 0) then
        begin
          VirtualWidth := iX;
          VirtualHeight := iY;
        end;
      end
      else if XML.CurrentElement = TAG_COLOUR then
      begin
        sColour := XML.GetAttribute(ATTR_NAME);
        if sColour <> '' then Colour := ColourList.GetColour(sColour);
      end
      else if (XML.CurrentElement = TAG_FILL) or
              (XML.CurrentElement = TAG_GRADEDFILL) or
              (XML.CurrentElement = TAG_LINEARFILL) then
      begin
        sFill := XML.GetAttribute(ATTR_NAME);
        if sFill <> '' then Fill := FillList.GetFill(sFill);
      end
      else if (XML.CurrentElement = TAG_LOADING) then
      begin
        sLoad := XML.GetAttribute(ATTR_ONDEMAND);
        if sLoad <> '' then LoadOnDemand := Str2Bool(sLoad);
      end;
end;

procedure TAHMBitmap.BuildProperties(Properties: TAHMUIPropertyList);
begin
{$IFDEF DESIGNER}
  inherited;

  // Build custom bitmap properties
  Properties.Add('File Name', 'Filename', CAT_BITMAP, HINT_FILENAME);
  Properties.Add('Fixed Aspect', 'PreserveAspect', CAT_BITMAP, HINT_ASPECT);
  Properties.Add('Colour', 'Colour', CAT_BITMAP, HINT_COLOUR);
  Properties.Add('Fill', 'Fill', CAT_BITMAP, HINT_FILL);
  Properties.Add('Delay Loading', 'LoadOnDemand', CAT_BITMAP, HINT_DEMAND);
  Properties.Add('Width', 'VirtualWidth', CAT_BITMAP, HINT_WIDTH);
  Properties.Add('Height', 'VirtualHeight', CAT_BITMAP, HINT_HEIGHT);
{$ENDIF}
end;


end.
